Configuracion del notebook ¶
Ajustes especificos para controlar la apariencia de las graficas en jupyter lab
suppressMessages(library(repr))
options(repr.plot.width=25,
repr.plot.height=10,
#repr.plot.pointsize=50,
repr.plot.family='serif'
)
Cargamos todos los paquetes necesarios para ejecutar el notebook
suppressMessages(library(saqgetr))
suppressMessages(library(tidyverse))
suppressMessages(library(lubridate))
suppressMessages(library(worldmet))
# En lugar de cargar el paquete openair se utiliza el ggopenair,
# otro paquete desarrollado por el mismo que Openair con el objetivo de
# utilizar ggplot2 en lugar de lattice para la representaciones graficas
#
#suppressMessages(library(openair))
suppressMessages(library(ggopenair))
suppressMessages(library(gridExtra))
suppressMessages(library(mblm))
Inicializamos ciertas variables con los parametros de estudio
# contaminantes a estudiar
pollutants <- c("no", "no2", "o3", "pm10")
# fechas de inicio y final de toma de datos
start_dt <- ymd_hms("2015-01-01 00:00:00")
end_dt <- ymd_hms("2020-10-01 00:00:00")
# fecha de inicio de confinamiento
lckdwn_strt <- ymd_hms("2020-03-14 00:00:00")
Leer los datos de fichero ¶
Se pueden extraer directamente los datos ya seleccionados de las estaciones de estudio y los datos de la calidad del aire de los archivos ../xlsx/dataAQV.csv y ../xlsx/estaciones.csv respectivamente. Si no se tienen dichos archivos o se quieren modificar los parametros de estudio se ejecutara la seccion Estaciones de España
if (file.exists("../xlsx/estaciones.csv")) {
sites <- read.csv("../xlsx/estaciones.csv")
}
head(sites)
if (file.exists("../xlsx/dataAQV.csv")) {
dataAQV <- read.csv("../xlsx/dataAQV.csv")
# Convert date to datetime format
dataAQV$date <- ymd_hms(dataAQV$date)
}
head(dataAQV)
Estaciones de España ¶
Datos geograficos de las estaciones ¶
Seleccionamos aquellas estaciones que se encuentren en un núcleo con una
población mayor o igual a cien mil habitantes poblacion >= 100 000 hab.
En la hoja 8 ciudades-100000-A-JA de la base de datos de poblaciones (estaciones-CA.xlsx) aparecen todas las estaciones de trafico de las ciudades de mas de 100000 habitantes con sus nombres.
# Loading
library("readxl")
file <- "../xlsx/estaciones-CA-JA.xlsx"
sheets <- c("todas", "traffic", "traffic-urban", "traffic-urban-2020",
"traffic-suburban", "traffic-suburban-2020",
"ciudades-100000", "ciudades-100000-A")
# xlsx files
sites.100mil <- read_excel(file, sheet=sheets[8])
head(sites.100mil)
Datos de las estaciones de saqgetr ¶
Importamos la informacion de las estaciones de calidad de aire de españa obtenidas de la base de datos y filtramos segun los criterios de estudio.
| Variable | Valores |
|---|---|
| Contaminantes | $NO$, $NO_2$, $O_3$, $PM_{10}$ |
| Fecha Inicio | 01 Enero 2015 |
| Fecha Final | 31 Diciembre 2020 |
| Site Type | traffic |
| site area | urban |
# obtener datos de CA de España. Salen los códigos de las estaciones
# de Calidad de aire (941)
spain.sites <- get_saq_sites() %>%
filter(country == "spain",
site %in% sites.100mil$"Código estación",
site_type == "traffic",
site_area == "urban",
date_start <= start_dt,
date_end >= end_dt,
)
removed.sites <- nrow(sites.100mil) - nrow(spain.sites)
print(paste("Se han eliminado", removed.sites, "estaciones"))
print(paste("Quedan", nrow(spain.sites), "estaciones para el estudio"))
Agrupamos en un solo data.frame toda la informacion relevante de las estaciones de estudio
sites.info <- get_saq_processes() %>%
filter(site %in% spain.sites$site,
variable %in% pollutants,
date_start <= start_dt,
#date_end >= end_dt,
) %>%
select(site, variable, period, unit, date_start, date_end)
sites.geo <- sites.100mil %>%
select("Municipio", "Población",
"Estación tráfico", "Código estación") %>%
rename(site = "Código estación",)
sites <- merge(x = sites.info, y = sites.geo, by = "site", all.x = TRUE)
head(sites)
Estudio de los Datos ¶
suppressMessages(dataAQV <- get_saq_observations(
site = levels(as.factor(sites$site))[2:5],
variable = pollutants,
valid_only = TRUE,
start = start_dt,
end = end_dt,
verbose = TRUE
))
El paquete saqgetr nos permite 'limpiar' los datos, obteniendo directamente los datos con una resolucion horaria o diaria. Ademas, esta funcion permite mediante el atributo spread=False remodelar el dataframe pivotando las columnas variable y value, obteniendo un dataframe con los contamiantes por columna.
dataAQV.cln <- saq_clean_observations(dataAQV,
summary = "hour",
#valid_only = TRUE,
#spread = TRUE,
)
No obstante, no te permite trabajar con otra resolucion que no sea horaria o diaria por lo que he creado dos funciones pivot.by.pollut y group.by.date para obtener las mismas transformaciones pero con la resolucion que quiera. Esto lo he hecho solo con el objetivo de familiarizarme con los datos.
Las funciones se pueden encontrar en el script ../src/funciones.R
source("../src/funciones.R")
Resolucion de 1 dia ¶
group.day <- group.by.date(dataAQV, by="day", FUN="mean")
preCOVID <- ggplot(data = group.day[group.day$date < lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
COVID <- ggplot(data = group.day[group.day$date > lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
grid.arrange(preCOVID, COVID, nrow = 1)
Probando otra forma ¶
group.test.hr <- group.by.date(dataAQV, by="8hour", FUN="mean")
group.test.dy <- group.by.date(group.test.hr, by="day", FUN="max")
preCOVID <- ggplot(data = group.test.dy[group.test.dy$date < lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
COVID <- ggplot(data = group.test.dy[group.test.dy$date > lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
grid.arrange(preCOVID, COVID, nrow = 1)
Resolucion de 1 semana ¶
group.wk <- group.by.date(dataAQV, by="week", FUN="mean")
preCOVID <- ggplot(data = group.wk[group.wk$date < lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
COVID <- ggplot(data = group.wk[group.wk$date > lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
grid.arrange(preCOVID, COVID, nrow = 1)
Resolucion de 1 mes ¶
group.mth <- group.by.date(dataAQV, by="month", FUN="mean")
preCOVID <- ggplot(data = group.mth[group.mth$date < lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
COVID <- ggplot(data = group.mth[group.mth$date > lckdwn_strt, ],
aes(x = date, y = value, color=variable)
) +
geom_line() +
geom_line() +
facet_wrap(~site, ncol=1)
grid.arrange(preCOVID, COVID, nrow = 1)
Analisis de los Datos ¶
Se aplican algunas funciones propias de R para mostrar el potencial de los datos combinandolos con paquetes estadisticos existentes
Theil-Sen function ¶
Se comparan las graficas obtenidas mediante la funcion propia de Openair para el estimador Theil-Sein y las obtenidas mediante otro metodo externo.
test.theilSen <- pivot.by.pollut(dataAQV,
pollutants=pollutants,
by="week",
#site=sites$site[3]
)
test.theilSen$fit <- rep(0, nrow(test.theilSen))
for (site in levels(as.factor(test.theilSen$site))) {
fit <- mblm(no2 ~ id + 1,
test.theilSen[test.theilSen$site == site, ],
repeated=T)
test.theilSen[test.theilSen$site == site, ]$fit <- fit$fitted.values
}
my.plt <- ggplot(data=test.theilSen, aes(x=date)) +
geom_point(aes(y=no2, color=site)) +
geom_line(aes(y=no2, color=site)) +
geom_line(aes(y=fit, color=site)) +
facet_wrap(~site)
theil.plt <- suppressMessages(TheilSen(test.theilSen,
deseason = F,
pollutant = "no2",
#site=sites$site[3],
avg.time = "month",
type="site",
)
)
grid.arrange(my.plt, theil.plt$plot, nrow = 1)
Funcion lm ¶
data.lm <- group.wk[group.wk$site == "es0118a"
& group.wk$variable == "o3",][ c("value", "date")]
data.lm["id"] <- seq.int(nrow(data.lm))
lm.fit <- lm(value ~ sin(2*pi/(1*52.1429)*id)+cos(2*pi/(1*52.1429)*id),
data=data.lm)
ggplot() +
geom_point(data=data.lm, aes(x=date, y=value), color="red") +
geom_line(aes(x=data.lm$date, y=lm.fit$fitted.values), color="blue")
data.lm$dSW <- data.lm$value - lm.fit$fitted.values
ggplot() +
geom_line(data=data.lm, aes(x=date, y=scale(dSW)), color="red")
Guardar Datos en xlsx ¶
write.csv(dataAQV, "../xlsx/dataAQV.csv")
write.csv(sites, "../xlsx/estaciones.csv")